home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / 32kedit / 32kedit4.bas < prev    next >
BASIC Source File  |  1993-07-08  |  28KB  |  435 lines
  1. 10 '       制作  元内康博   ３万色ツール   Ｇ３２ＫＧＴ
  2. 20 '   Ｖｅｒ　４.１４  １９９２年６月１０日～１０月０６日
  3. 30 COLOR 7:SCREEN@1:CLEAR:CLS 4:DEFINT A-Z:RANDOMIZE -TIME:CONSOLE 0,25,0:DIM CPIC(8288),CO(3),絵(38399),処理絵(38399),MJ$(13):FOR A=0 TO 2:CO(A)=255:NEXT:CDC=0
  4. 40 FOR A=0 TO 13:READ MJ$(A):NEXT
  5. 50 DATA  １６ドットを拡大,４８ドットを拡大,色を変える,絵を元に戻す,画面消去,塗り潰し,ＳＡＶＥ ＬＯＡＤ,色を変える処理,線や円などの処理,絵の複写,拡大 or 字を書く,ＣＤＰＬＡＥＲ,プログラムを終了,オプションを指定
  6. 60 OP=4:DIM OP(OP):FOR A=0 TO OP:READ OP(A):NEXT
  7. 70 DATA 16,64,16,16,8
  8. 80 MOUSE 0:MOUSE 1,,,1:MOUSE 4,0,0,319,239:GOSUB *PICIN:MODE=0:PASTEL 64
  9. 90 ON KEY (1) GOSUB *メモ記録:ON KEY (2) GOSUB *メモ見る:KEY (1) ON:KEY (2) ON
  10. 100 *MAIN
  11. 110 LINE(C1X,C1Y)-(C1X+15,C1Y+15),XOR,7,B:LINE(C2X,C2Y)-(C2X+47,C2Y+47),XOR,7,B:LINE(C1X,C1Y)-(C1X+15,C1Y+15),XOR,7,B:LINE(C2X,C2Y)-(C2X+47,C2Y+47),XOR,7,B
  12. 120 IF MOUSE(2,1)=-1 THEN 180
  13. 130 IF MOUSE(2,0)=0 THEN *MAIN
  14. 140 C1X=INT(MOUSE(0)/16)*16:C1Y=INT(MOUSE(1)/16)*16
  15. 150 C2X=C1X:C2Y=C1Y:IF C2X>272 THEN C2X=272
  16. 160 IF C2Y>192 THEN C2Y=192
  17. 170 GOTO 110
  18. 180 MOUSE 1,,,0:GET@A(0,0)-(319,239),処理絵:CC=13:MOUSE 4,50,0,219,15+CC*16:FOR A=0 TO CC:LINE(50,0+A*16)-(220,16+A*16),PSET,7,BF,0
  19. 190 SYMBOL(60,A*16),MJ$(A),1,1,7:NEXT
  20. 200 MOUSE 1,,,1
  21. 210 CY=INT(MOUSE(1)/16):LINE(50,CY*16)-(220,CY*16+16),XOR,7,BF:LINE(50,CY*16)-(220,16+CY*16),XOR,7,BF
  22. 220 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:PUT@A(0,0)-(319,239),処理絵:WAIT 15:GOTO *MAIN
  23. 230 IF MOUSE(2,0)=0 THEN 210
  24. 240 MOUSE 4,0,0,319,239:PUT@A(0,0)-(319,239),処理絵:IF CY<>2 AND CY<>3 THEN GOSUB *PICIN
  25. 250 IF CY=0 THEN *B16
  26. 260 IF CY=1 THEN *B48
  27. 270 IF CY=2 THEN GOSUB *色設定:GOTO *MAIN
  28. 280 IF CY=3 THEN 2990
  29. 290 IF CY=4 THEN *画面消去
  30. 300 IF CY=5 THEN *塗り潰し
  31. 310 IF CY=6 THEN *DISK
  32. 320 IF CY=7 THEN *画像処理
  33. 330 IF CY=8 THEN *絵を描く
  34. 340 IF CY=9 THEN *複写
  35. 350 IF CY=10 THEN *その他
  36. 360 IF CY=11 THEN *CD
  37. 370 IF CY=12 THEN 400
  38. 380 IF CY=13 THEN *ｵﾌﾟｼｮﾝ
  39. 390 GOTO 180
  40. 400 COLOR 12:LOCATE 0,25:PRINT "プログラムを終了していいですか？";:GOSUB *YN:COLOR 7:CLS 4:GOSUB *PICOUT
  41. 410 IF CY=0 THEN END ELSE *MAIN
  42. 420 *ｵﾌﾟｼｮﾝ
  43. 430 PASTEL 72:LINE(0,0)-(319,15+OP*16),PASTEL,0,BF:MOUSE 1,,,0:SYMBOL(0,0),"範囲指定塗り潰しのドット",1,1,7:SYMBOL(0,16),"混合比率(９－２４２)",1,1,7:SYMBOL(0,32),"明るさを変える時の大きさ",1,1,7:SYMBOL(0,48),"霧吹きの範囲",1,1,7
  44. 440 SYMBOL(0,64),"マウスの移動速度",1,1,7
  45. 450 MOUSE 4,260,0,319,OP*16+15
  46. 460 MOUSE 1,,,0:LINE(260,0)-(319,OP*16+15),PSET,0,BF:FOR A=0 TO OP:SYMBOL(260,A*16),"↓　　↑",1,1,7:SYMBOL(276,A*16),STR$(OP(A)),1,1,7:NEXT:MOUSE 1,,,1
  47. 470 CX=INT((MOUSE(0)-260)/30):CY=INT(MOUSE(1)/16)
  48. 480 IF MOUSE(2,1)=-1 THEN PASTEL OP(1):MOUSE 4,0,0,319,239:GOSUB *PICOUT:GOTO *MAIN
  49. 490 IF MOUSE(2,0)=0 THEN 470
  50. 500 IF CX=0 THEN IX=-1 ELSE IX=1
  51. 510 ON CY+1 GOTO 520,540,560,580,600
  52. 520 IF IX=-1 THEN OP(0)=8 ELSE OP(0)=16
  53. 530 GOTO 460
  54. 540 OP(1)=OP(1)+IX:IF OP(1)<9 THEN OP(1)=9 ELSE IF OP(1)>242 THEN OP(1)=242
  55. 550 GOTO 460
  56. 560 OP(2)=OP(2)+IX*8:IF OP(2)<8 THEN OP(2)=8 ELSE IF OP(2)>128 THEN OP(2)=128
  57. 570 GOTO 460
  58. 580 OP(3)=OP(3)+IX:IF OP(3)<6 THEN OP(3)=6 ELSE IF OP(3)>64 THEN OP(3)=64
  59. 590 GOTO 460
  60. 600 OP(4)=OP(4)+IX:IF OP(4)<1 THEN OP(4)=1 ELSE IF OP(4)>32 THEN OP(4)=32
  61. 610 MOUSE 3,0,OP(4):MOUSE 3,1,OP(4):GOTO 460
  62. 620 *CD
  63. 630 ON ERROR GOTO *ECD:IF CDC=0 THEN CDC=1:CD PLAY:GOTO *MAIN
  64. 640 CDC=0:CD STOP:GOTO *MAIN
  65. 650 *ECD:RESUME *MAIN
  66. 660 *その他
  67. 670 LINE(100,100)-(220,132),PSET,7,BF,0:SYMBOL(100,100),"文字を出力する",1,1,7:SYMBOL(100,116),"拡大縮小する",1,1,7:MOUSE 4,100,100,220,131
  68. 680 CY=INT((MOUSE(1)-100)/16):LINE(100,100+CY*16)-(220,115+CY*16),XOR,7,BF:LINE(100,100+CY*16)-(220,115+CY*16),XOR,7,BF
  69. 690 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,319,239:GOTO *MAIN
  70. 700 IF MOUSE(2,0)=0 THEN 680
  71. 710 GOSUB *PICOUT:MOUSE 4,0,0,319,239:WAIT 15:IF CY=0 THEN *字 ELSE *拡大
  72. 720 *字
  73. 730 CLS:PRINT "出力する文字を入力してください。":LINE INPUT A$:CC!=1:P=OP(0):C2=LEN(A$)*8
  74. 740 MOUSE 1,,,0:CLS:LINE(50,100)-(133,116),PSET,7,BF,0:SYMBOL(50,100),"↓",1,1,7:SYMBOL(116,100),"↑",1,1,7:SYMBOL(0,0),A$,CC!,CC!,[CO(0),CO(1),CO(2)]:SYMBOL(66,100),STR$(CC!),1,1,7:MOUSE 1,,,1:MOUSE 4,50,100,133,115
  75. 750 CX=INT((MOUSE(0)-50)/44):IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOTO 800
  76. 760 IF MOUSE(2,0)=0 THEN 750
  77. 770 IF CX=0 THEN CC!=CC!-.1! ELSE CC!=CC!+.1!
  78. 780 IF CC!<.1! THEN CC!=.1!
  79. 790 GOTO 740
  80. 800 GOSUB *PICOUT:MOUSE 4,0,0,319,239:LOCATE 0,25:COLOR 12:PRINT "何処に文字を書きますか｡";:COLOR 7
  81. 810 CX=INT(MOUSE(0)/P)*P:CY=INT(MOUSE(1)/P)*P:LINE(CX,CY)-(CX+C2*CC!,CY+16*CC!),XOR,7,BF:LINE(CX,CY)-(CX+C2*CC!,CY+16*CC!),XOR,7,BF
  82. 820 IF MOUSE(2,0)=0 THEN 810
  83. 830 CLS 4:SYMBOL(CX,CY),A$,CC!,CC!,[CO(0),CO(1),CO(2)]:GOTO *MAIN
  84. 840 *拡大
  85. 850 COLOR 12:LOCATE 0,25:PRINT "何処から拡大縮小しますか？";:COLOR 7:P=OP(0)
  86. 860 CX=INT(MOUSE(0)/P)*P:CY=INT(MOUSE(1)/P)*P:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B
  87. 870 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  88. 880 IF MOUSE(2,0)=0 THEN 860
  89. 890 CLS 4:WAIT 20:CCX=CX:CCY=CY
  90. 900 COLOR 12:LOCATE 0,25:PRINT "何処まで拡大縮小しますか？";:COLOR 7
  91. 910 CX=INT(MOUSE(0)/P)*P-1:CY=INT(MOUSE(1)/P)*P-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  92. 920 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  93. 930 IF MOUSE(2,0)=0 THEN 910
  94. 940 CLS 4:MOUSE 1,,,0:GET@A(CCX,CCY)-(CX,CY),処理絵:CC!=1:CCX=CX-CCX:CCY=CY-CCY:MOUSE 4,50,100,133,115
  95. 950 LINE(50,100)-(133,116),PSET,7,BF,0:SYMBOL(50,100),"↓",1,1,7:SYMBOL(116,100),"↑",1,1,7:SYMBOL(67,100),STR$(CC!),1,1,7:MOUSE 1,,,1
  96. 960 CX=INT((MOUSE(0)-50)/44):IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOTO 1010
  97. 970 IF MOUSE(2,0)=0 THEN 960
  98. 980 IF CX=0 THEN CC!=CC!-.1! ELSE CC!=CC!+.1!
  99. 990 IF CC!<.1! THEN CC!=.1!
  100. 1000 MOUSE 1,,,0:PUT@A(0,0)-(CCX,CCY),処理絵,,CC!,CC!:GOTO 950
  101. 1010 COLOR 12:GOSUB *PICOUT:LOCATE 0,25:PRINT "何処に置きますか｡";:COLOR 7
  102. 1020 CX=INT(MOUSE(0)/P)*P:CY=INT(MOUSE(1)/P)*P:LINE(CX,CY)-(CX+CCX*CC!,CY+CCY*CC!),XOR,7,BF:LINE(CX,CY)-(CX+CCX*CC!,CY+CCY*CC!),XOR,7,BF
  103. 1030 IF MOUSE(2,0)=0 THEN 1020
  104. 1040 MOUSE 1,,,0:PUT@A(CX,CY)-(CCX+CX,CCY+CY),処理絵,,CC!,CC!:MOUSE 1,,,1:CLS 4:GOTO *MAIN
  105. 1050 *複写
  106. 1060 LINE(100,50)-(200,97),PSET,7,BF,0:MOUSE 4,100,50,200,97:FOR A=0 TO 2:SYMBOL(110,50+A*16),KMID$("１６ドット４８ドット範囲の複写",1+A*5,5),1,1,7:NEXT
  107. 1070 CY=INT((MOUSE(1)-50)/16):LINE(100,50+CY*16)-(200,65+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(200,65+CY*16),XOR,7,BF
  108. 1080 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOSUB *PICOUT:GOTO *MAIN
  109. 1090 IF MOUSE(2,0)=0 THEN 1070
  110. 1100 MOUSE 4,0,0,319,239:GOSUB *PICOUT:WAIT 20:IF CY=0 THEN 1130
  111. 1110 IF CY=1 THEN 1190
  112. 1120 IF CY=2 THEN 1240
  113. 1130 GET@A(C1X,C1Y)-(C1X+15,C1Y+15),処理絵
  114. 1140 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:GET@A(CX,CY)-(CX+15,CY+15),処理絵,256
  115. 1150 PUT@A(CX,CY)-(CX+15,CY+15),処理絵:PUT@A(CX,CY)-(CX+15,CY+15),処理絵,,,,,256
  116. 1160 IF MOUSE(2,1)=-1 THEN *MAIN
  117. 1170 IF MOUSE(2,0)=0 THEN 1140
  118. 1180 PUT@A(CX,CY)-(CX+15,CY+15),処理絵:GOTO 1140
  119. 1190 GET@A(C2X,C2Y)-(C2X+47,C2Y+47),処理絵
  120. 1200 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:GET@A(CX,CY)-(CX+47,CY+47),処理絵,2304:PUT@A(CX,CY)-(CX+47,CY+47),処理絵:PUT@A(CX,CY)-(CX+47,CY+47),処理絵,,,,,2304
  121. 1210 IF MOUSE(2,1)=-1 THEN *MAIN
  122. 1220 IF MOUSE(2,0)=0 THEN 1200
  123. 1230 PUT@A(CX,CY)-(CX+47,CY+47),処理絵:WAIT 10:GOTO 1200
  124. 1240 COLOR 12:LOCATE 0,25:PRINT "何処から複写しますか｡";:COLOR 7:P=OP(0)
  125. 1250 CX=INT(MOUSE(0)/P)*P:CY=INT(MOUSE(1)/P)*P:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B
  126. 1260 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  127. 1270 IF MOUSE(2,0)=0 THEN 1250
  128. 1280 CCX=CX:CCY=CY:CLS 4:WAIT 20
  129. 1290 CX=INT(MOUSE(0)/P)*P-1:CY=INT(MOUSE(1)/P)*P:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  130. 1300 IF MOUSE(2,0)=0 THEN 1290
  131. 1310 GET@A(CCX,CCY)-(CX,CY),処理絵:WAIT 20:CCX=CX-CCX:CCY=CY-CCY
  132. 1320 CX=INT(MOUSE(0)/P)*P:CY=INT(MOUSE(1)/P)*P:PUT@A(CX,CY)-(CX+CCX,CY+CCY),処理絵:GOSUB *PICOUT
  133. 1330 IF MOUSE(2,0)=0 THEN 1320
  134. 1340 PUT@A(CX,CY)-(CX+CCX,CY+CCY),処理絵:GOTO *MAIN
  135. 1350 *絵を描く
  136. 1360 LINE(100,50)-(200,129),PSET,7,BF,0:MOUSE 4,100,50,200,129:FOR A=0 TO 4:SYMBOL(108,50+A*16),KMID$(" 線を描く太線を描く霧吹で描く円を描く 直線を描く",1+A*5,5),1,1,7:NEXT
  137. 1370 CY=INT((MOUSE(1)-50)/16):LINE(100,50+CY*16)-(200,65+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(200,65+CY*16),XOR,7,BF
  138. 1380 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOSUB *PICOUT:GOTO *MAIN
  139. 1390 IF MOUSE(2,0)=0 THEN 1370
  140. 1400 MOUSE 4,0,0,319,239:WAIT 15:GOSUB *PICOUT:C1=0:C2=0:IF CY=0 THEN 1450
  141. 1410 IF CY=1 THEN 1520
  142. 1420 IF CY=2 THEN 1570
  143. 1430 IF CY=3 THEN 1640
  144. 1440 IF CY=4 THEN 1720
  145. 1450 CX=MOUSE(0):CY=MOUSE(1)
  146. 1460 IF MOUSE(2,1)=-1 THEN *MAIN
  147. 1470 IF MOUSE(2,0)=-1 THEN 1500
  148. 1480 IF C1=1 THEN C2=C2-1:IF C2=0 THEN C1=0
  149. 1490 GOTO 1450
  150. 1500 IF C1=0 THEN PSET(CX,CY),[CO(0),CO(1),CO(2)]:CCX=CX:CCY=CY:C2=9:C1=1:GOTO 1450
  151. 1510 LINE(CCX,CCY)-(CX,CY),PSET,[CO(0),CO(1),CO(2)]:C2=9:CCX=CX:CCY=CY:GOTO 1450
  152. 1520 DEF PEN 0,4
  153. 1530 CX=MOUSE(0):CY=MOUSE(1)
  154. 1540 IF MOUSE(2,1)=-1 THEN DEF PEN 0:GOTO *MAIN
  155. 1550 IF MOUSE(2,0)=0 THEN 1530
  156. 1560 PSET(CX,CY),[CO(0),CO(1),CO(2)]:GOTO 1530
  157. 1570 CX=MOUSE(0):CY=MOUSE(1)
  158. 1580 IF MOUSE(2,1)=-1 THEN *MAIN
  159. 1590 IF MOUSE(2,0)=0 THEN 1570
  160. 1600 MOUSE 1,,,0:P=OP(3):P1=P/2:FOR A=1 TO P:R=CO(0)+INT(RND*32-16):IF R>255 THEN R=255 ELSE IF R<0 THEN R=0
  161. 1610 B=CO(1)+INT(RND*32-16):IF B>255 THEN B=255 ELSE IF B<0 THEN B=0
  162. 1620 G=CO(2)+INT(RND*32-16):IF G>255 THEN G=255 ELSE IF G<0 THEN G=0
  163. 1630 PSET(CX+RND*P-P1,CY+RND*P-P1),[R,B,G]:NEXT:MOUSE 1,,,1:GOTO 1570
  164. 1640 COLOR 12:LOCATE 0,25:PRINT "何処から円を描きますか｡";:COLOR 7
  165. 1650 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  166. 1660 IF MOUSE(2,0)=0 THEN 1650
  167. 1670 CCX=CX:CCY=CY:CLS 4:CX=MOUSE(9):CY=0:COLOR 12:LOCATE 0,25:PRINT "塗り潰す時は 右クリック";:COLOR 7:WAIT 15
  168. 1680 CIRCLE(CCX,CCY),CY,[CO(0),CO(1),CO(2)],,,,,XOR:CIRCLE(CCX,CCY),CY,[CO(0),CO(1),CO(2)],,,,,XOR:CX=MOUSE(9):CY=CY+CX:IF CY<0 THEN CY=0
  169. 1690 IF MOUSE(2,0)=-1 THEN CIRCLE(CCX,CCY),CY,[CO(0),CO(1),CO(2)]:CLS 4:GOTO *MAIN
  170. 1700 IF MOUSE(2,1)=-1 THEN CIRCLE(CCX,CCY),CY,[CO(0),CO(1),CO(2)],,,,F:CLS 4:GOTO *MAIN
  171. 1710 GOTO 1680
  172. 1720 COLOR 12:LOCATE 0,25:PRINT "何処から線を描きますか｡";:COLOR 7
  173. 1730 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  174. 1740 IF MOUSE(2,0)=0 THEN 1730
  175. 1750 CCX=CX:CCY=CY:CLS 4:WAIT 20
  176. 1760 CX=MOUSE(0):CY=MOUSE(1):LINE(CCX,CCY)-(CX,CY),XOR,[CO(0),CO(1),CO(2)]:LINE(CCX,CCY)-(CX,CY),XOR,[CO(0),CO(1),CO(2)]
  177. 1770 IF MOUSE(2,0)=0 THEN 1760
  178. 1780 LINE(CCX,CCY)-(CX,CY),PSET,[CO(0),CO(1),CO(2)]:GOTO *MAIN
  179. 1790 *画像処理
  180. 1800 LINE(100,49)-(200,115),PSET,7,BF,0:MOUSE 4,100,50,200,113:FOR A=0 TO 3:SYMBOL(101,50+A*16),KMID$("明るくする 暗くする色を換える 混合する",1+A*5,5),1,1,7:NEXT
  181. 1810 CY=INT((MOUSE(1)-50)/16):LINE(100,50+CY*16)-(200,65+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(200,65+CY*16),XOR,7,BF
  182. 1820 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOSUB *PICOUT:GOTO *MAIN
  183. 1830 IF MOUSE(2,0)=0 THEN 1810
  184. 1840 WAIT 20:MOUSE 4,0,0,319,239:GOSUB *PICOUT:IF CY=0 THEN CC=OP(2):GOTO 1890
  185. 1850 IF CY=1 THEN CC=-OP(2):GOTO 1890
  186. 1860 IF CY=2 THEN CC=1:GOTO 1890
  187. 1870 IF CY=3 THEN CC=2:GOTO 1890
  188. 1880 GOTO 1800
  189. 1890 MOUSE 4,0,0,320,240:LOCATE 0,25:COLOR 12:PRINT "何処から変えますか";:COLOR 7
  190. 1900 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B:LINE(CX,CY)-(CX+15,CY+15),XOR,7,B
  191. 1910 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  192. 1920 IF MOUSE(2,0)=0 THEN 1900
  193. 1930 CLS 4:COLOR 12:LOCATE 0,25:PRINT "何処まで変えますか？";:COLOR 7:CCX=CX:CCY=CY:WAIT 20
  194. 1940 CX=INT(MOUSE(0)/16)*16-1:CY=INT(MOUSE(1)/16)*16-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  195. 1950 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  196. 1960 IF MOUSE(2,0)=0 THEN 1940
  197. 1970 CLS 4:MOUSE 4,0,0,319,239:MOUSE 1,,,0:IF CC=1 THEN 2040
  198. 1980 IF CC=2 THEN LINE(CCX,CCY)-(CX,CY),PASTEL,[CO(0),CO(1),CO(2)],BF:MOUSE 1,,,1:GOTO *MAIN
  199. 1990 FOR A=CCY TO CY:FOR B=CCX TO CX:C1=PEEK([&H1C]B*2+A*1024):C2=PEEK([&H1C]B*2+A*1024+1):A2=INT(C1 AND 31)*8+CC:A0=((C2 AND 127)-(C2 AND 3))*2+CC:A1=INT((INT(C2 AND 3)*64+INT(C1/8)*2)/8)*8+CC
  200. 2000 IF A0<0 THEN A0=0 ELSE IF A0>255 THEN A0=255
  201. 2010 IF A1<0 THEN A1=0 ELSE IF A1>255 THEN A1=255
  202. 2020 IF A2<0 THEN A2=0 ELSE IF A2>255 THEN A2=255
  203. 2030 PSET(B,A),[A0,A1,A2]:NEXT:NEXT:MOUSE 1,,,1:GOTO *MAIN
  204. 2040 A0=CO(0):A1=CO(1):A2=CO(2):C3X=CX:C3Y=CY:GOSUB *色設定:B0=CO(0):B1=CO(1):B2=CO(2):CO(0)=A0:CO(1)=A1:CO(2)=A2
  205. 2050 MOUSE 1,,,0:FOR A=CCY TO C3Y:FOR B=CCX TO C3X:C1=PEEK([&H1C]B*2+A*1024):C2=PEEK([&H1C]B*2+A*1024+1):A2=INT(C1 AND 31)*8:A0=((C2 AND 127)-(C2 AND 3))*2:A1=INT((INT(C2 AND 3)*64+INT(C1/8)*2)/8)*8
  206. 2060 C0=A0-CO(0):C1=A1-CO(1):C2=A2-CO(2):IF ABS(C0)<49 AND ABS(C1)<49 AND ABS(C2)<49 THEN C0=B0+C0:C1=B1+C1:C2=B2+C2 ELSE NEXT:NEXT:GOTO 2120
  207. 2070 IF C0<0 THEN C0=0 ELSE IF C0>255 THEN C0=255
  208. 2080 IF C1<0 THEN C1=0 ELSE IF C1>255 THEN C1=255
  209. 2090 IF C2<0 THEN C2=0 ELSE IF C2>255 THEN C2=255
  210. 2100 PSET(B,A),[C0,C1,C2]
  211. 2110 NEXT:NEXT
  212. 2120 MOUSE 1,,,1:GOTO *MAIN
  213. 2130 *DISK
  214. 2140 LINE(50,50)-(140,82),PSET,7,BF,0:SYMBOL(61,51),"ＳＡＶＥ",1,1,7:SYMBOL(61,68),"ＬＯＡＤ",1,1,7:MOUSE 4,50,50,150,81
  215. 2150 CY=INT((MOUSE(1)-50)/16):LINE(50,50+CY*16)-(140,66+CY*16),XOR,7,BF:LINE(50,50+CY*16)-(140,66+CY*16),XOR,7,BF:IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,319,239:GOTO *MAIN
  216. 2160 IF MOUSE(2,0)=0 THEN 2150
  217. 2170 MOUSE 4,0,0,319,239:IF CY=0 THEN *SAVE
  218. 2180 *LOAD
  219. 2190 CLS:PRINT "どのドライブからＬＯＡＤしますか？":A$=INPUT$(1):IF A$=CHR$(13) THEN GOSUB *PICOUT:CLS 4:ON ERROR GOTO 0:GOTO *MAIN
  220. 2200 IF ASC(A$)<65 OR ASC(A$)>81 THEN 2190
  221. 2210 EC=0:ON ERROR GOTO *E1:SHELL A$+":":PRINT A$+"ドライブ"
  222. 2220 EC=0:FILES A$+":*.TIF"
  223. 2230 PRINT "ディレクトリを変える時は CD ????    終わる時は RET  "
  224. 2240 LINE INPUT B$:IF B$="" THEN CLS:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  225. 2250 IF LEFT$(B$,2)="CD" THEN SHELL B$:GOTO 2210
  226. 2260 EC=1:CLS:GOSUB *PICOUT:COLOR 12:LOCATE 9,25:PRINT "ＬＯＡＤする場所を指定してください｡";:COLOR 7
  227. 2270 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:LINE(CX,CY)-(319,239),XOR,7,B:LINE(CX,CY)-(319,239),XOR,7,B
  228. 2280 IF MOUSE(2,1)=-1 THEN ON ERROR GOTO 0:GOTO *MAIN
  229. 2290 IF MOUSE(2,0)=0 THEN 2270
  230. 2300 CLS 4:LOCATE 9,25:PRINT "しばらくお待ち下さい｡";:LOAD@ A$+":"+B$+".TIF",(CX,CY):CLS 4:ON ERROR GOTO 0:GOTO *MAIN
  231. 2310 *E1
  232. 2320 IF ERR=55 THEN PRINT "ファイル名が正しくありません｡":BEEP:WAIT 200:RESUME 2190
  233. 2330 IF ERR=72 THEN PRINT "ディスクがセットされていません｡":BEEP:WAIT 200:RESUME 2190
  234. 2340 IF ERR=60 THEN PRINT A$+"ドライブは使用できません｡":BEEP:WAIT 200:RESUME 2190
  235. 2350 IF ERR=63 THEN 2390
  236. 2360 IF ERR=28 AND EC=1 THEN CLS 4:LOCATE 0,25:PRINT "このファイルは読み込めません";:WAIT 200:CLS 4:GOSUB *PICOUT:ON ERROR GOTO 0:RESUME *MAIN
  237. 2370 IF ERR=112 AND EC=1 THEN CLS 4:LOCATE 0,25:PRINT "このファイルはこのツールでは読み込めません";:WAIT 200:CLS 4:GOSUB *PICOUT:ON ERROR GOTO 0:RESUME *MAIN
  238. 2380 ON ERROR GOTO 0:GOSUB *PICOUT:RESUME
  239. 2390 IF EC=0 THEN PRINT "ＴＩＦファイルが存在していません｡":FILES A$+":*.*":RESUME 2230
  240. 2400 IF EC=1 THEN CLS 4:LOCATE 0,25:COLOR 12:PRINT "指定のファイル 「 "+A$+":"+B$+".TIF 」は存在していません";:WHILE MOUSE(2,1)=0:WEND:COLOR 7:CLS 4:ON ERROR GOTO 0:RESUME *MAIN
  241. 2410 *SAVE
  242. 2420 COLOR 12:LOCATE 0,25:PRINT "ＳＡＶＥする範囲を指定してください｡";:COLOR 7:WAIT 20:MOUSE 4,0,0,320,240
  243. 2430 CX=INT(MOUSE(0)/16)*16-1:CY=INT(MOUSE(1)/16)*16-1:LINE(0,0)-(CX,CY),XOR,7,B:LINE(0,0)-(CX,CY),XOR,7,B
  244. 2440 IF MOUSE(2,1)=-1 THEN CLS:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  245. 2450 IF MOUSE(2,0)=0 THEN 2430
  246. 2460 CLS:PRINT "どのドライブにＳＡＶＥしますか？":A$=INPUT$(1):IF A$=CHR$(13) THEN CLS:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  247. 2470 IF ASC(A$)<65 OR ASC(A$)>81 THEN 2460
  248. 2480 IF A$="Q" THEN PRINT "ＱドライブにはＳＡＶＥ出来ません｡":BEEP:WAIT 200:GOTO 2460
  249. 2490 ON ERROR GOTO *E2:SHELL A$+":"
  250. 2500 EC=0:FILES A$+":*.*"
  251. 2510 PRINT "ディレクトリを変える時は CD ????    終わる時は RET  "
  252. 2520 LINE INPUT B$:IF B$="" THEN CLS:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  253. 2530 IF LEFT$(B$,2)="CD" THEN SHELL B$:GOTO 2500
  254. 2540 ON ERROR GOTO *E2:EC=1:CLS 4:GOSUB *PICOUT:SAVE@ A$+":"+B$+".TIF",(0,0)-(CX,CY):ON ERROR GOTO 0:GOTO *MAIN 
  255. 2550 *E2
  256. 2560 IF ERR=55 THEN PRINT "ファイル名が正しくありません｡":BEEP:WAIT 200:RESUME 2460
  257. 2570 IF ERR=60 THEN PRINT A$+"ドライブは使用できません｡":BEEP:WAIT 200:RESUME 2460
  258. 2580 IF ERR=63 THEN PRINT "ファイルは１つもありません｡":RESUME 2510
  259. 2590 IF ERR=64 THEN RESUME 2620
  260. 2600 IF ERR=72 THEN PRINT "ディスクがセットされていません｡":BEEP:WAIT 200:RESUME 2460
  261. 2610 ON ERROR GOTO 0:GOSUB *PICOUT:RESUME
  262. 2620 CLS:PRINT "既にファイルが存在していますが､どうしますか｡":PRINT " １. ＳＡＶＥをする｡   ２. そのファイルを見る｡   ３. OR [RET] 中止":Q$=INPUT$(1)
  263. 2630 IF Q$="1" THEN KILL A$+":"+B$+".TIF":GOTO 2540
  264. 2640 IF Q$="3" OR Q$=CHR$(13) THEN CLS 4:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  265. 2650 ON ERROR GOTO *E3
  266. 2660 LOAD@ B$+".TIF":PRINT "何かキーを押してください"
  267. 2670 IF MOUSE(2,0)=0 AND MOUSE(2,1)=0 AND INKEY$="" THEN 2670
  268. 2680 GOTO 2620
  269. 2690 *E3
  270. 2700 PRINT "何かの理由で読み込めません｡":WAIT 200:RESUME 2620
  271. 2710 *塗り潰し
  272. 2720 LINE(100,100)-(200,164),PSET,7,BF,0:FOR A=0 TO 3:SYMBOL(100,100+A*16),KMID$("同色塗り潰し １６ドット ４８ドット範囲塗り潰し",A*6+1,6),1,1,7:NEXT:MOUSE 4,100,100,200,163
  273. 2730 CY=INT((MOUSE(1)-100)/16):LINE(100,100+CY*16)-(200,115+CY*16),XOR,7,BF:LINE(100,100+CY*16)-(200,115+CY*16),XOR,7,BF
  274. 2740 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOSUB *PICOUT:GOTO *MAIN
  275. 2750 IF MOUSE(2,0)=0 THEN 2730
  276. 2760 WAIT 20:MOUSE 4,0,0,319,239:GOSUB *PICOUT:IF CY=0 THEN 2890
  277. 2770 IF CY=1 THEN LINE(C1X,C1Y)-(C1X+15,C1Y+15),PSET,[CO(0),CO(1),CO(2)],BF:GOTO *MAIN
  278. 2780 IF CY=2 THEN LINE(C2X,C2Y)-(C2X+47,C2Y+47),PSET,[CO(0),CO(1),CO(2)],BF:GOTO *MAIN
  279. 2790 *範囲塗り潰し
  280. 2800 MOUSE 4,0,0,320,240:COLOR 12:LOCATE 0,25:PRINT "何処から塗り潰しますか？";:COLOR 7:P=OP(0)
  281. 2810 CX=INT(MOUSE(0)/P)*P:CY=INT(MOUSE(1)/P)*P:LINE(CX,CY)-(CX+P-1,CY+P-1),XOR,7,B:LINE(CX,CY)-(CX+P-1,CY+P-1),XOR,7,B
  282. 2820 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  283. 2830 IF MOUSE(2,0)=0 THEN 2810
  284. 2840 CLS 4:COLOR 12:LOCATE 0,25:PRINT "何処まで塗り潰しますか？";:COLOR 7:CCX=CX:CCY=CY:WAIT 20
  285. 2850 CX=INT(MOUSE(0)/P)*P-1:CY=INT(MOUSE(1)/P)*P-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  286. 2860 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  287. 2870 IF MOUSE(2,0)=0 THEN 2850
  288. 2880 LINE(CCX,CCY)-(CX,CY),PSET,[CO(0),CO(1),CO(2)],BF:CLS 4:MOUSE 4,0,0,319,239:GOTO *MAIN
  289. 2890 *同色塗り潰し
  290. 2900 LOCATE 0,25:COLOR 12:PRINT "何処から塗り潰しますか｡";:COLOR 7
  291. 2910 CX=MOUSE(0):CY=MOUSE(1)
  292. 2920 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  293. 2930 IF MOUSE(2,0)=0 THEN 2910
  294. 2940 CLS 4:PAINT@(CX,CY),[CO(0),CO(1),CO(2)]:GOTO *MAIN
  295. 2950 *画面消去
  296. 2960 LOCATE 10,24:PRINT "画面を消去していいですか｡";:GOSUB *YN:CLS 4
  297. 2970 IF CY=0 THEN CLS
  298. 2980 GOTO *MAIN
  299. 2990 LOCATE 9,25:PRINT "画面を元に戻しますか｡";:GOSUB *YN
  300. 3000 CLS 4:IF CY=0 THEN GOSUB *PICOUT:GOTO *MAIN ELSE *MAIN
  301. 3010 *B16
  302. 3020 GET@A(C1X,C1Y)-(C1X+15,C1Y+15),処理絵
  303. 3030 MOUSE 1,,,0:CLS:PUT@A(0,0)-(15,15),処理絵,,15,15:FOR A=0 TO 16:C=A*15:LINE(0,C)-(239,C),PSET,[0,0,96]:LINE(C,0)-(C,239),PSET,[0,0,96]:NEXT:LINE(0,120)-(240,120),PSET,7,,&H6666:LINE(120,0)-(120,240),PSET,7,,&H6666
  304. 3040 FOR A=0 TO 4:LINE(240,A*16)-(319,A*16+16),PSET,7,B:SYMBOL(240,A*16),KMID$("色を変える色を調べる直線をひく",A*5+1,5),1,1,7:NEXT:PUT@A(241,200)-(256,215),処理絵:LINE(240,199)-(257,216),PSET,7,B
  305. 3050 LINE(257,200)-(319,217),PSET,3+MODE,BF,0:SYMBOL(258,200),KMID$("ノーマル混ぜる ランダム",MODE*4+1,4),1,1,3+MODE
  306. 3060 LINE(260,224)-(275,239),PSET,7,BF,[CO(0),CO(1),CO(2)]
  307. 3070 MOUSE 4,0,0,319,239:MOUSE 1,,,1:WAIT 9
  308. 3080 IF MOUSE(2,1)=-1 THEN GET@A(241,200)-(256,215),処理絵:GOSUB *PICOUT:PUT@A(C1X,C1Y)-(C1X+15,C1Y+15),処理絵:GOTO *MAIN
  309. 3090 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,0)=0 THEN 3080
  310. 3100 IF CX<240 THEN 3170
  311. 3110 IF CX>240 AND CY<64 THEN 3240
  312. 3120 IF CX>260 AND CY>224 AND CX<275 THEN GOSUB *色設定:GOTO 3060
  313. 3130 IF CX>258 AND CY>200 AND CX<319 AND CY<217 THEN 3150
  314. 3140 GOTO 3070
  315. 3150 MODE=MODE+1:WAIT 15:IF MODE>2 THEN MODE=0
  316. 3160 GOTO 3050
  317. 3170 CX=INT(CX/15):CY=INT(CY/15):IF MODE=0 THEN PSET(CX+241,CY+200),[CO(0),CO(1),CO(2)]:LINE(CX*15+1,CY*15+1)-(CX*15+14,CY*15+14),PSET,[CO(0),CO(1),CO(2)],BF:GOTO 3070
  318. 3180 IF MODE=1 THEN PSET(CX+241,CY+200),[CO(0),CO(1),CO(2)],PASTEL:LINE(CX*15+1,CY*15+1)-(CX*15+14,CY*15+14),PASTEL,[CO(0),CO(1),CO(2)],BF:WAIT 5:GOTO 3070
  319. 3190 R=CO(0)+INT(RND*32-16):B=CO(1)+INT(RND*32-16):G=CO(2)+INT(RND*32-16)
  320. 3200 IF R<0 THEN R=0 ELSE IF R>255 THEN R=255
  321. 3210 IF G<0 THEN G=0 ELSE IF G>255 THEN G=255
  322. 3220 IF B<0 THEN B=0 ELSE IF B>255 THEN B=255
  323. 3230 PSET(CX+241,CY+200),[R,B,G]:LINE(CX*15+1,CY*15+1)-(CX*15+14,CY*15+14),PSET,[R,B,G],BF:GOTO 3070
  324. 3240 CY=INT(CY/16):IF CY=0 THEN GOSUB *色設定:GOTO 3060
  325. 3250 IF CY=1 THEN 3370
  326. 3260 IF CY=2 THEN 3280
  327. 3270 GOTO 3070
  328. 3280 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"直線をひく",.75!,1,6:WAIT 15
  329. 3290 CX=INT(MOUSE(0)/15):CY=INT(MOUSE(1)/15):LINE(CX*15,CY*15)-(CX*15+14,CY*15+14),XOR,7,BF:LINE(CX*15,CY*15)-(CX*15+14,CY*15+14),XOR,7,BF
  330. 3300 IF MOUSE(2,1)=-1 THEN 3070
  331. 3310 IF MOUSE(2,0)=0 THEN 3290
  332. 3320 CCX=CX:CCY=CY:WAIT 13
  333. 3330 CX=INT(MOUSE(0)/15):CY=INT(MOUSE(1)/15):LINE(CCX*15+7,CCY*15+7)-(CX*15+7,CY*15+7),XOR,7:LINE(CCX*15+7,CCY*15+7)-(CX*15+7,CY*15+7),XOR,7
  334. 3340 IF MOUSE(2,1)=-1 THEN 3070
  335. 3350 IF MOUSE(2,0)=0 THEN 3330
  336. 3360 LINE(CCX+241,CCY+200)-(CX+241,CY+200),PSET,[CO(0),CO(1),CO(2)]:GET@A(241,200)-(256,215),処理絵:GOTO 3030
  337. 3370 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"色を調べる",.75!,1,6:WAIT 15
  338. 3380 IF MOUSE(2,1)=-1 THEN 3070
  339. 3390 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,0)=0 THEN 3380
  340. 3400 MOUSE 4,0,0,319,239:CX=INT(241+CX/15):CY=INT(200+CY/15):C1=PEEK([&H1C]CX*2+CY*1024):C2=PEEK([&H1C]CX*2+CY*1024+1):CO(2)=INT(C1 AND 31)*8:CO(0)=((C2 AND 127)-(C2 AND 3))*2:CO(1)=INT((INT(C2 AND 3)*64+INT(C1/8)*2)/8)*8:MOUSE 4,0,0,319,239:GOTO 3050
  341. 3410 *B48
  342. 3420 GET@A(C2X,C2Y)-(C2X+47,C2Y+47),処理絵
  343. 3430 MOUSE 1,,,0:CLS:PUT@A(0,0)-(47,47),処理絵,,5,5:FOR A=0 TO 48:C=A*5:LINE(0,C)-(240,C),PSET,[0,0,96]:LINE(C,0)-(C,240),PSET,[0,0,96]:NEXT
  344. 3440 :FOR A=8 TO 47 STEP 8:LINE(0,A*5)-(240,A*5),PSET,7,,&H6666:LINE(A*5,0)-(A*5,240),PSET,7,,&H6666:NEXT
  345. 3450 FOR A=0 TO 5:LINE(240,A*16)-(319,A*16+16),PSET,7,B:SYMBOL(240,A*16),KMID$("色を変える色を調べる直線をひく 円を描く 塗り潰す四角の中塗",A*5+1,5),1,1,7:NEXT:PUT@A(260,150)-(307,197),処理絵:LINE(259,149)-(308,198),PSET,7,B
  346. 3460 LINE(257,200)-(319,217),PSET,MODE+3,BF,0:SYMBOL(258,200),KMID$("ノーマル混ぜる ランダム",MODE*4+1,4),1,1,MODE+3
  347. 3470 LINE(260,224)-(275,239),PSET,7,BF,[CO(0),CO(1),CO(2)]
  348. 3480 MOUSE 1,,,1:MOUSE 4,0,0,319,239:WAIT 9
  349. 3490 IF MOUSE(2,1)=-1 THEN GET@A(260,150)-(307,197),処理絵:GOSUB *PICOUT:PUT@A(C2X,C2Y)-(C2X+47,C2Y+47),処理絵:GOTO *MAIN 
  350. 3500 IF MOUSE(2,0)=0 THEN 3490
  351. 3510 CX=MOUSE(0):CY=MOUSE(1)
  352. 3520 IF CX<240 THEN 3830
  353. 3530 IF CX>258 AND CY>200 AND CX<319 AND CY<217 THEN 3900
  354. 3540 IF CX>260 AND CY>224 AND CX<275 AND CY<239 THEN GOSUB *色設定:GOTO 3470
  355. 3550 IF CX>240 AND CY<96 THEN 3570
  356. 3560 GOTO 3480
  357. 3570 CY=INT(CY/16):WAIT 15
  358. 3580 IF CY=0 THEN GOSUB *色設定:GOTO 3470
  359. 3590 IF CY=1 THEN 3790
  360. 3600 IF CY=2 THEN 3920
  361. 3610 IF CY=3 THEN 4000
  362. 3620 IF CY=4 THEN 3740
  363. 3630 IF CY=5 THEN 3650
  364. 3640 GOTO 3480
  365. 3650 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"四角の中塗",.75!,1,6:WAIT 12
  366. 3660 CX=INT(MOUSE(0)/5):CY=INT(MOUSE(1)/5):LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF:LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF
  367. 3670 IF MOUSE(2,1)=-1 THEN 3460
  368. 3680 IF MOUSE(2,0)=0 THEN 3660
  369. 3690 CCX=CX:CCY=CY:WAIT 12
  370. 3700 CX=INT(MOUSE(0)/5):CY=INT(MOUSE(1)/5):LINE(CX*5+2,CY*5+2)-(CCX*5+2,CCY*5+2),XOR,7,B:LINE(CX*5+2,CY*5+2)-(CCX*5+2,CCY*5+2),XOR,7,B
  371. 3710 IF MOUSE(2,1)=-1 THEN 3460
  372. 3720 IF MOUSE(2,0)=0 THEN 3700
  373. 3730 LINE(260+CX,150+CY)-(260+CCX,150+CCY),PSET,[CO(0),CO(1),CO(2)],BF:GET@A(260,150)-(307,197),処理絵:GOTO 3430
  374. 3740 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"塗り潰す",1,1,6:WAIT 15
  375. 3750 CX=INT(MOUSE(0)/5):CY=INT(MOUSE(1)/5):LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF:LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF
  376. 3760 IF MOUSE(2,1)=-1 THEN 3460
  377. 3770 IF MOUSE(2,0)=0 THEN 3750
  378. 3780 PAINT@(260+CX,150+CY),[CO(0),CO(1),CO(2)]:GET@A(260,150)-(307,197),処理絵:GOTO 3430
  379. 3790 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"色を調べる",.75!,1,6:WAIT 15
  380. 3800 IF MOUSE(2,1)=-1 THEN 3460
  381. 3810 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,0)=0 THEN 3800
  382. 3820 CX=INT(260+CX/5):CY=INT(150+CY/5):C1=PEEK([&H1C]CX*2+CY*1024):C2=PEEK([&H1C]CX*2+CY*1024+1):CO(2)=INT(C1 AND 31)*8:CO(0)=((C2 AND 127)-(C2 AND 3))*2:CO(1)=INT((INT(C2 AND 3)*64+INT(C1/8)*2)/8)*8:GOTO 3460
  383. 3830 CX=INT(CX/5):CY=INT(CY/5):IF MODE=1 THEN PSET(260+CX,150+CY),[CO(0),CO(1),CO(2)],PASTEL:LINE(CX*5+1,CY*5+1)-(CX*5+4,CY*5+4),PASTEL,[CO(0),CO(1),CO(2)],BF:GOTO 3480
  384. 3840 IF MODE=0 THEN PSET(260+CX,150+CY),[CO(0),CO(1),CO(2)]:LINE(CX*5+1,CY*5+1)-(CX*5+4,CY*5+4),PSET,[CO(0),CO(1),CO(2)],BF:GOTO 3480
  385. 3850 R=INT(CO(0)+RND*32-16):G=(CO(1)+RND*32-16):B=INT(CO(2)+RND*32-16)
  386. 3860 IF R>255 THEN R=255 ELSE IF R<0 THEN R=0
  387. 3870 IF G>255 THEN G=255 ELSE IF G<0 THEN G=0
  388. 3880 IF B>255 THEN B=255 ELSE IF B<0 THEN B=0
  389. 3890 PSET(260+CX,150+CY),[R,G,B]:LINE(CX*5+1,CY*5+1)-(CX*5+4,CY*5+4),PSET,[R,G,B],BF:GOTO 3480
  390. 3900 MODE=MODE+1:IF MODE>2 THEN MODE=0
  391. 3910 WAIT 15:GOTO 3460
  392. 3920 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"直線をひく",.8!,1,2:WAIT 15
  393. 3930 CX=INT(MOUSE(0)/5):CY=INT(MOUSE(1)/5):LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF:LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF
  394. 3940 IF MOUSE(2,1)=-1 THEN 3460
  395. 3950 IF MOUSE(2,0)=0 THEN 3930
  396. 3960 CCX=CX:CCY=CY:WAIT 20
  397. 3970 CX=INT(MOUSE(0)/5):CY=INT(MOUSE(1)/5):LINE(CCX*5+2,CCY*5+2)-(CX*5+2,CY*5+2),XOR,[CO(0),CO(1),CO(2)]:LINE(CCX*5+2,CCY*5+2)-(CX*5+2,CY*5+2),XOR,[CO(0),CO(1),CO(2)]
  398. 3980 IF MOUSE(2,0)=0 THEN 3970
  399. 3990 LINE(260+CCX,150+CCY)-(260+CX,150+CY),PSET,[CO(0),CO(1),CO(2)]:GET@A(260,150)-(307,197),処理絵:GOTO 3430
  400. 4000 MOUSE 4,0,0,239,239:LINE(257,200)-(319,217),PSET,6,BF,0:SYMBOL(258,201),"円を描く",1,1,2
  401. 4010 CX=INT(MOUSE(0)/5):CY=INT(MOUSE(1)/5):LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF:LINE(CX*5,CY*5)-(CX*5+4,CY*5+4),XOR,7,BF
  402. 4020 IF MOUSE(2,1)=-1 THEN 3460 
  403. 4030 IF MOUSE(2,0)=0 THEN 4010
  404. 4040 CCX=CX:CCY=CY:WAIT 20:CY=0:CX=MOUSE(9):MOUSE 4,0,0,319,239
  405. 4050 CIRCLE(CCX*5+2,CCY*5+2),CY,[CO(0),CO(1),CO(2)],,,,,XOR:CIRCLE(CCX*5+2,CCY*5+2),CY,[CO(0),CO(1),CO(2)],,,,,XOR:CX=MOUSE(9):CY=CY+CX:IF CY<0 THEN CY=0
  406. 4060 IF MOUSE(2,1)=-1 THEN 3460
  407. 4070 IF MOUSE(2,0)=0 THEN 4050
  408. 4080 CIRCLE(260+CCX,150+CCY),CY/5,[CO(0),CO(1),CO(2)]:GET@A(260,150)-(307,197),処理絵:GOTO 3430
  409. 4090 *PICIN:GET@A(0,0)-(319,239),絵:RETURN
  410. 4100 *PICOUT:PUT@A(0,0)-(319,239),絵:RETURN
  411. 4110 *YN
  412. 4120 GET@A(0,0)-(319,239),処理絵:LINE(100,100)-(150,132),PSET,7,BF,0:SYMBOL(101,101),"Ｙｅｓ",1,1,7:SYMBOL(109,117),"Ｎｏ",1,1,7:MOUSE 4,100,100,150,131
  413. 4130 CY=INT((MOUSE(1)-100)/16):LINE(100,100+CY*16)-(150,116+CY*16),XOR,7,BF:LINE(100,100+CY*16)-(150,116+CY*16),XOR,7,BF
  414. 4140 IF MOUSE(2,0)=0 THEN 4130
  415. 4150 MOUSE 4,0,0,319,239:PUT@A(0,0)-(319,239),処理絵:WAIT 20:RETURN
  416. 4160 *色設定
  417. 4170 MOUSE 1,,,0:GET@A(0,210)-(294,237),CPIC:MOUSE 4,30,210,294,236:LINE(29,210)-(294,237),PSET,7,BF
  418. 4180 FOR G=0 TO 32:CX=G*8:CC=CX:IF CC>255 THEN CC=255
  419. 4190 LINE(30+CX,211)-(37+CX,218),PSET,[CC,0,0],BF
  420. 4200 LINE(30+CX,220)-(37+CX,227),PSET,[0,CC,0],BF
  421. 4210 LINE(30+CX,229)-(37+CX,236),PSET,[0,0,CC],BF
  422. 4220 NEXT
  423. 4230 LINE(0,210)-(25,235),PSET,7,BF,[CO(0),CO(1),CO(2)]
  424. 4240 COLOR 12:FOR A=0 TO 2:LINE(30+CO(A),211+A*9)-(37+CO(A),218+A*9),XOR,7,B:LOCATE 74,22+A:PRINT CO(A);:NEXT:COLOR 7:MOUSE 1,,,1
  425. 4250 CX=INT(MOUSE(0)-30):CY=INT((MOUSE(1)-210)/9)
  426. 4260 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:PUT@A(0,210)-(294,237),CPIC:CLS 4:WAIT 30:RETURN
  427. 4270 IF MOUSE(2,0)=0 THEN 4250
  428. 4280 FOR A=0 TO 2:LINE(30+CO(A),211+A*9)-(37+CO(A),218+A*9),XOR,7,B:NEXT
  429. 4290 CO(CY)=INT(CX/8)*8:IF CO(CY)>255 THEN CO(CY)=255
  430. 4300 MOUSE 1,,,0:GOTO 4230
  431. 4310 *メモ記録
  432. 4320 PRINT :COLOR 12:LINE INPUT MEM$:COLOR 7:CLS 4:RETURN
  433. 4330 *メモ見る
  434. 4340 PRINT :COLOR 12:PRINT MEM$:COLOR 7:WHILE INKEY$<>CHR$(13):WEND:CLS 4:RETURN
  435.